home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0003_Get Run-time addr of virtual methods.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  2.7 KB  |  99 lines
  1.  
  2. PROGRAM Tst_VMT;
  3.  
  4. Type   TAObject = object
  5.                    constructor Init;
  6.                    procedure   MethodA; virtual;
  7.                    procedure   MethodB; virtual;
  8.                   end;
  9. Type   TBObject = object(TAObject)
  10.                    procedure   MethodA; virtual;
  11.                   end;
  12.  
  13. Var    MethodAOffsetInVMT,
  14.        MethodBOffsetInVMT  : integer;
  15.        ItIsAObject         : TAObject;
  16.        ItIsBObject         : TBObject;
  17.  
  18. {--- TAObject -------------------------------------------------------}
  19.  
  20. Constructor TAObject.Init;
  21.  
  22. Begin
  23. End;
  24.  
  25. {--------------------------------------------------------------------}
  26.  
  27. Procedure TAObject.MethodA;
  28.  
  29. Begin
  30.     Writeln('It is method A !!!');
  31. End;
  32.  
  33. {--------------------------------------------------------------------}
  34.  
  35. Procedure TAObject.MethodB;
  36.  
  37. Begin
  38.     Writeln('It is method B !!!');
  39. End;
  40.  
  41. {--- TAObject -------------------------------------------------------}
  42.  
  43. Procedure TBObject.MethodA;
  44.  
  45. Begin
  46.     Writeln('It is method A (some changed) !!!');
  47. End;
  48.  
  49. {--------------------------------------------------------------------}
  50.  
  51. Function GetOffsetInVMT(VMTAddr : pointer; MethodAddr : pointer): integer;
  52.  
  53. Type   TAddrRec       = record  Offs,Segm : word  end;
  54.  
  55. Const  VMTHeaderSize  = 8;     { This is a size of VMT header     }
  56.        MaxMethodsOffs = 100 * SizeOf(pointer) + VMTHeaderSize;
  57.                        { Maximal offset of method in VMT (abstract) }
  58.  
  59. Var    VMTOffs        : word;
  60.        CurAddr        : ^pointer;
  61.  
  62. Begin
  63.     VMTOffs := VMTHeaderSize;
  64.     While (VMTOffs < MaxMethodsOffs) and
  65.           (pointer( Ptr(TAddrRec(VMTAddr).Segm,
  66.                         TAddrRec(VMTAddr).Offs + VMTOffs)^
  67.                   ) <> MethodAddr) do
  68.      Inc(VMTOffs, SizeOf(pointer));
  69.     If VMTOffs >= MaxMethodsOffs
  70.      then  GetOffsetInVMT := 0   { Damn, there is no such method! }
  71.      else  GetOffsetInVMT := VMTOffs;
  72. End;
  73.  
  74. {--------------------------------------------------------------------}
  75.  
  76. Begin
  77.     ItIsAObject.Init;
  78.     ItIsBObject.Init;
  79.     ItIsAObject.MethodA;
  80.     ItIsAObject.MethodB;
  81.     MethodAOffsetInVMT := GetOffsetInVMT(TypeOf(TAObject),
  82.                                          @TAObject.MethodA);
  83.     MethodBOffsetInVMT := GetOffsetInVMT(TypeOf(TAObject),
  84.                                          @TAObject.MethodB);
  85.     Writeln(MethodAOffsetInVMT);
  86.     Writeln(MethodBOffsetInVMT);
  87.  
  88.     { --- Let's call TBObject.MethodA  }
  89.     asm
  90.       mov  di,offset ItIsBObject
  91.       push ds              { Pushing @Self for object in stack }
  92.       push di
  93.       mov  di,[di]         { VMT offset in data segment }
  94.       add  di,[MethodAOffsetInVMT]  { Adding method offset in VMT }
  95.       call dword ptr [di]
  96.     end;
  97. End.
  98.  
  99.